import Data.Char (isDigit)
import Data.List (transpose, isPrefixOf, (\\))
import qualified Data.Set as Set
import qualified Data.Map as Map

splitAll :: Eq a => [a] -> [a] -> [[a]]
splitAll _ [] = []
splitAll delims xs = 
    token : splitAll delims rest
    where
        isDelimiter = (`elem` delims)
        token       = takeWhile (not . isDelimiter) xs
        rest        = dropWhile isDelimiter $ dropWhile (not . isDelimiter) xs

type Feild = Int
type Range = (Feild, Feild)
type FeildName = String
type FeilKind = (FeildName, Range, Range)
type Ticket = [Feild]

type Document = ([FeilKind], Ticket, [Ticket])

feildName :: FeilKind -> FeildName 
feildName (name, _, _) = name

-- "67,107,59,79,53,131,61,101,71,73,137,109,157,113,173,103,83,167,149,163"
parseTicket :: String -> Ticket
parseTicket = map read . splitAll "," 

-- 43-322
parseRange :: String -> Range
parseRange string = (low, heigh)
    where
        low = read . takeWhile isDigit $ string
        heigh = read . tail . dropWhile isDigit $ string

-- departure location: 42-322 or 347-954
parseFeildKind :: String -> FeilKind
parseFeildKind string = (name, range1, range2)
    where
        name = takeWhile (/=':') string
        rangeStrings = splitAll " or " 
                     . drop 2 
                     . dropWhile (/=':') $ string

        range1 = parseRange (rangeStrings !! 0)
        range2 = parseRange (rangeStrings !! 1)

parseInput :: String -> Document
parseInput input = (kinds, myTicket, nearbyTickets)
    where
        tokens = splitAll [""] . lines $ input

        kinds = map parseFeildKind (tokens !! 0)
        myTicket = parseTicket . last $ (tokens !! 1)
        nearbyTickets = map parseTicket . tail $ (tokens !! 2)

-----------------------------------------------------------------

isFeildInRange :: Feild -> Range -> Bool
isFeildInRange feild (left, right) = (feild >= left) && (feild <= right)

isFeildInKind :: Feild -> FeilKind -> Bool
isFeildInKind feild (_, range1, range2) = (isFeildInRange feild range1) || (isFeildInRange feild range2)

isFeildInKinds :: Feild -> [FeilKind] -> Bool
isFeildInKinds feild kinds = any (isFeildInKind feild) kinds 

isTicketValid :: [FeilKind] -> Ticket -> Bool
isTicketValid kinds ticket = all (\f -> isFeildInKinds f kinds) ticket

isFeildsMatchKind :: [Feild] -> FeilKind -> Bool
isFeildsMatchKind feilds kind = all (\f -> isFeildInKind f kind) feilds

------------------------------------------------------------------

filterValidTickets :: [FeilKind] -> [Ticket] -> [Ticket]
filterValidTickets kinds = filter (isTicketValid kinds) 

getOptionKinds :: [FeilKind] -> [Feild] -> [FeildName]
getOptionKinds kinds feilds = map feildName . filter (isFeildsMatchKind feilds) $ kinds

type Record = Map.Map Int FeildName
type Option = Map.Map Int [FeildName]

folding :: (Record, [Int], [FeildName]) -> (Int, [FeildName]) -> (Record, [Int], [FeildName])
folding state@(record, ensureCols, usedName) (col, options) = 
    if length options == 1 
        then (Map.insert col option record, col:ensureCols, option:usedName)
        else state      
    where
        option = head options

decideOptions :: Option -> Record
decideOptions options = fst $ doDecideOptions (Map.empty, options)

doDecideOptions :: (Record, Option) -> (Record, Option)
doDecideOptions (record, options) = 
    if length options == 0 
        then (record, options)
        else doDecideOptions (record', options'')
    where
        optionLst = Map.toList options
        (record', ensureCols, usedName) = foldl folding (record, [], []) optionLst

        -- remove ensure col
        options' = foldl (\op col -> Map.delete col op) options ensureCols

        -- remove usedName
        options'' = Map.fromList 
                    . map (\(col, names) -> (col, names \\ usedName)) 
                    . Map.toList
                    $ options'
                
main :: IO ()
main = do
    input <- readFile "input.txt"

    let (kinds, myTicket, nearbyTickets) = parseInput input

    let validTickets = filterValidTickets kinds nearbyTickets
    
    let options = Map.fromList 
                . zip [0..]
                . map (getOptionKinds kinds) 
                . transpose 
                $ validTickets 

    let record = Map.toList $ decideOptions options

    print . product
          . map ((myTicket !! ) . fst)
          . filter (isPrefixOf "departure" . snd) 
          $ record
